home *** CD-ROM | disk | FTP | other *** search
/ Linux Cubed Series 3: Developer Tools / Linux Cubed Series 3 - Developer Tools.iso / devel / lang / fortran / toolpack.000 / toolpack / toolpack1.2 / tables / LIST.f < prev    next >
Encoding:
Text File  |  1989-03-04  |  7.4 KB  |  290 lines
  1. C ======================================================================
  2. C
  3. C       L I N K E D   L I S T   H A N D L E R
  4. C
  5. C       External: There are two record types, HEAD (list headers)
  6. C                 and LINK (list elements).
  7. C
  8. C       Internal: Each of these is a LINKAGE element, with two pointers,
  9. C                 PRED & SUCC.
  10. C
  11. C       A list is a circular list, where
  12. C           each PRED/SUCC pointer points to the previous/next item,
  13. C           but is negative if the previous/next item is a HEAD record.
  14. C
  15. C       (Thus) an empty list has both pointers in the HEAD negative.
  16. C
  17. C       An unattached LINK has zero pointers.
  18. C
  19. C ----------------------------------------------------------------------
  20. C
  21. C       L L C R E L   -   Create a list element
  22. C
  23.  
  24.         INTEGER FUNCTION LLCREL(ARRAY,HSIZE)
  25.         INTEGER ARRAY(*),HSIZE
  26.  
  27.         INTEGER BLOCK
  28.  
  29.         INTEGER LLGMEM
  30.         EXTERNAL LLGMEM
  31.  
  32.         BLOCK=LLGMEM(ARRAY,HSIZE+2)
  33.         ARRAY(BLOCK)=0
  34.         ARRAY(BLOCK+1)=0
  35.         LLCREL=BLOCK+2
  36.  
  37.         END
  38. C ----------------------------------------------------------------------
  39. C
  40. C       L L C R H E   -   Create a list head
  41. C
  42.  
  43.         INTEGER FUNCTION LLCRHE(ARRAY,HSIZE)
  44.         INTEGER ARRAY(*),HSIZE
  45.  
  46.         INTEGER BLOCK
  47.  
  48.         INTEGER LLGMEM
  49.         EXTERNAL LLGMEM
  50.  
  51.         BLOCK=LLGMEM(ARRAY,HSIZE+2)
  52.         LLCRHE=BLOCK+2
  53.         ARRAY(BLOCK)=-LLCRHE
  54.         ARRAY(BLOCK+1)=-LLCRHE
  55.  
  56.         END
  57. C ----------------------------------------------------------------------
  58. C
  59. C       L L C R H D   -   Create a list head with data
  60. C
  61.  
  62.         INTEGER FUNCTION LLCRHD(ARRAY,HSIZE,HDATA)
  63.         INTEGER ARRAY(*),HSIZE,HDATA(HSIZE)
  64.  
  65.         INTEGER I
  66.  
  67.         INTEGER LLCRHE
  68.  
  69.         LLCRHD=LLCRHE(ARRAY,HSIZE)
  70.         DO 100 I=1,HSIZE
  71.             ARRAY(LLCRHD+I-1)=HDATA(I)
  72.  100    CONTINUE
  73.  
  74.         END
  75. C ----------------------------------------------------------------------
  76. C
  77. C       L L C R E D   -   Create a list element with data
  78. C
  79.  
  80.         INTEGER FUNCTION LLCRED(ARRAY,LSIZE,LDATA)
  81.         INTEGER ARRAY(*),LSIZE,LDATA(LSIZE)
  82.  
  83.         INTEGER I
  84.  
  85.         INTEGER LLCREL
  86.  
  87.         LLCRED=LLCREL(ARRAY,LSIZE)
  88.         DO 100 I=1,LSIZE
  89.             ARRAY(LLCRED+I-1)=LDATA(I)
  90.  100    CONTINUE
  91.  
  92.         END
  93. C ----------------------------------------------------------------------
  94. C
  95. C       L L O U T   -   Remove an element from a list
  96. C
  97.  
  98.         SUBROUTINE LLOUT(ARRAY,LINK)
  99.         INTEGER ARRAY(*),LINK
  100.  
  101.         INTEGER I
  102.  
  103. C If not in any list, just return
  104.         IF (ARRAY(LINK-1).EQ.0) RETURN
  105. C Set L.PRED.SUCC:-L.SUCC
  106.         ARRAY(ABS(ARRAY(LINK-1))-2)=ARRAY(LINK-2)
  107. C Set L.SUCC.PRED:-L.PRED
  108.         ARRAY(ABS(ARRAY(LINK-2))-1)=ARRAY(LINK-1)
  109. C Clear pointers
  110.         ARRAY(LINK-1)=0
  111.         ARRAY(LINK-2)=0
  112.  
  113.         END
  114. C ----------------------------------------------------------------------
  115. C
  116. C       L L P R E C   -   Make one linkage precede another
  117. C       L L I N T O   -   Insert an element into a list
  118. C
  119.  
  120.         SUBROUTINE LLPREC(ARRAY,LINK,LINKAG)
  121.         INTEGER ARRAY(*),LINK,LINKAG
  122.  
  123.         ENTRY LLINTO(ARRAY,LINK,LINKAG)
  124.  
  125.         INTEGER PRED
  126.  
  127.         PRED=ABS(ARRAY(LINKAG-1))
  128.  
  129. C Remove LINK from any current list
  130.         IF (ARRAY(LINK-1).NE.0) CALL LLOUT(ARRAY,LINK)
  131.  
  132. C Set SUCC(LINK)=SUCC(PRED(LINKAG))
  133.         ARRAY(LINK-2)=ARRAY(PRED-2)
  134. C Set SUCC(PRED)=LINK
  135.         ARRAY(PRED-2)=LINK
  136. C Set PRED(LINK)=PRED(LINKAG)
  137.         ARRAY(LINK-1)=ARRAY(LINKAG-1)
  138. C Set PRED(LINKAG)=LINK
  139.         ARRAY(LINKAG-1)=LINK
  140. C If SUCC(LINKAG).EQ.LINKAG, set SUCC(LINKAG)=LINK
  141.         IF (ARRAY(LINKAG-2).EQ.-LINKAG) ARRAY(LINKAG-2)=LINK
  142.  
  143.         END
  144. C ----------------------------------------------------------------------
  145. C
  146. C       L L F O L L   -   Make a link follow a linkage
  147. C
  148.  
  149.         SUBROUTINE LLFOLL(ARRAY,LINK,LINKAG)
  150.         INTEGER ARRAY(*),LINK,LINKAG
  151.  
  152.         INTEGER SUCC
  153.  
  154.         SUCC=ABS(ARRAY(LINKAG-2))
  155.  
  156. C Remove LINK from any current list
  157.         IF (ARRAY(LINK-1).NE.0) CALL LLOUT(ARRAY,LINK)
  158.  
  159. C  L.PRED :- LINKAGE.SUCC.PRED      ! copy LINKAG ptr from its successor
  160. C                                   ! (back-link from new element)
  161.         ARRAY(LINK-1)=ARRAY(SUCC-1)
  162.  
  163. C  LINKAGE.SUCC.PRED :- L           ! back-link to new element
  164.         ARRAY(SUCC-1)=LINK
  165.  
  166. C  L.SUCC :- LINKAGE.SUCC           ! forward link from new element
  167.         ARRAY(LINK-2)=ARRAY(LINKAG-2)
  168.  
  169. C  LINKAGE.SUCC :- L                ! forward link to next element
  170.         ARRAY(LINKAG-2)=LINK
  171.  
  172.         END
  173. C ----------------------------------------------------------------------
  174. C
  175. C       L L N E X T   -   Return next element of list or 0 if last
  176. C       L L F I R S   -   Return first element of list
  177. C
  178.  
  179.         INTEGER FUNCTION LLNEXT(ARRAY,ITEM)
  180.         INTEGER ARRAY(*),ITEM
  181.  
  182.         INTEGER LLFIRS
  183.         ENTRY LLFIRS(ARRAY,ITEM)
  184.  
  185.         LLNEXT=MAX(ARRAY(ITEM-2),0)
  186.  
  187.         END
  188. C ----------------------------------------------------------------------
  189. C
  190. C       L L P R E D   -   Return predecessor of item
  191. C
  192.  
  193.         INTEGER FUNCTION LLPRED(ARRAY,ITEM)
  194.         INTEGER ARRAY(*),ITEM
  195.  
  196.         LLPRED=ABS(ARRAY(ITEM-1))
  197.  
  198.         END
  199. C ----------------------------------------------------------------------
  200. C
  201. C       L L P R E V   -   Return previous element of list or 0 if first
  202. C       L L L A S T   -   Return last element of list
  203. C
  204.  
  205.         INTEGER FUNCTION LLPREV(ARRAY,ITEM)
  206.         INTEGER ARRAY(*),ITEM
  207.  
  208.         INTEGER LLLAST
  209.         ENTRY LLLAST(ARRAY,ITEM)
  210.  
  211.         LLPREV=MAX(ARRAY(ITEM-1),0)
  212.  
  213.         END
  214. C ----------------------------------------------------------------------
  215. C
  216. C       L L H E A D   -   Return head of a list
  217. C
  218.  
  219.         INTEGER FUNCTION LLHEAD(ARRAY,LINK)
  220.         INTEGER ARRAY(*),LINK
  221.  
  222.         IF (ARRAY(LINK-1).EQ.0) CALL ERROR('LLHEAD: Detached link')
  223.         LLHEAD=LINK
  224.  100    LLHEAD=ARRAY(LLHEAD-1)
  225.         IF (LLHEAD.GT.0) GOTO 100
  226.         LLHEAD=-LLHEAD
  227.  
  228.         END
  229. C ----------------------------------------------------------------------
  230. C
  231. C       L L D E L E   -   Delete a list element
  232. C
  233.  
  234.         SUBROUTINE LLDELE(ARRAY,LINK)
  235.         INTEGER ARRAY(*),LINK
  236.  
  237.         EXTERNAL LLFREE
  238.  
  239.         IF (ARRAY(LINK-1).NE.0) CALL LLOUT(ARRAY,LINK)
  240.         CALL LLFREE(ARRAY,LINK-2)
  241.  
  242.         END
  243. C ----------------------------------------------------------------------
  244. C
  245. C       L L D E L H   -   Delete a list head
  246. C
  247.  
  248.         SUBROUTINE LLDELH(ARRAY,HEAD)
  249.         INTEGER ARRAY(*),HEAD
  250.  
  251.         EXTERNAL LLFREE
  252.  
  253.         IF (ARRAY(HEAD-2).GT.0) CALL ERROR('LLDELH: List is''t empty')
  254.         CALL LLFREE(ARRAY,HEAD-2)
  255.  
  256.         END
  257. C ----------------------------------------------------------------------
  258. C
  259. C       L L F I N D   -   Find a value in a list or sub-list
  260. C
  261. C       Given a head pointer, returns 0 or a pointer to the first elt
  262. C       which matches VALUE, OFFSET specifying which field (word) to
  263. C       check (0=first).
  264. C
  265. C       Given a link pointer, does exactly the same but only that part
  266. C       of the list *past* the given pointer is checked (i.e. acts as
  267. C       a "find next occurrence" routine).
  268. C
  269. C       If a nil pointer is passed (i.e. zero) the 0 return is given.
  270. C
  271.  
  272.         INTEGER FUNCTION LLFIND(ARRAY,LINKAG,OFFSET,VALUE)
  273.         INTEGER ARRAY(*),LINKAG,OFFSET,VALUE
  274.  
  275.         INTEGER LLNEXT
  276.  
  277.         IF (LINKAG.EQ.0) THEN
  278.             LLFIND=0
  279.         ELSE
  280.             LLFIND=LLNEXT(ARRAY,LINKAG)
  281.             IF (LLFIND.EQ.0) RETURN
  282.  100        IF (ARRAY(LLFIND).NE.VALUE) THEN
  283.                 LLFIND=LLNEXT(ARRAY,LLFIND)
  284.                 IF (LLFIND.NE.0) GOTO 100
  285.             END IF
  286.         END IF
  287.  
  288.         END
  289.  
  290.